perm filename FILDIS.F4[TMP,LCS] blob
sn#147683 filedate 1975-02-24 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DIMENSION QQ(200),NE(200),II(3000)
C00004 ENDMK
Cā;
DIMENSION QQ(200),NE(200),II(3000)
EQUIVALENCE (QQ,NE)
111 CALL DPYSET(1,II,3000)
CALL SETCUR(0,0,0)
I=1
7 JOIN=I
1 ACCEPT 2,L
2 FORMAT(A1)
CALL RDCUR(NX,NY)
IF(L.EQ.'F')GO TO 22
IF(L.EQ.'J')GO TO 33
QQ(I)=NX
QQ(I+1)=NY
NE(I+2)=2
IF(I.EQ.JOIN)NE(I+2)=3
CALL LINES(QQ(I),QQ(I+1),NE(I+2))
CALL DPYOUT(1)
I=I+3
GO TO 1
33 QQ(I)=QQ(JOIN)
QQ(I+1)=QQ(JOIN+1)
NE(I+2)=2
CALL LINES(QQ(I),QQ(I+1),2)
CALL DPYOUT(1)
I=I+3
GO TO 7
22 NE(3)=I-1
TYPE 4
4 FORMAT(' INC= '$)
ACCEPT 5,M
5 FORMAT(I)
CALL FILLER(QQ,M)
CALL DPYOUT(1)
ACCEPT 2,L
GO TO 111
END
SUBROUTINE LINES(RX,RY,J)
NX=RX
NY=RY
IF(J.EQ.3)GO TO 1
CALL AVECT(NX,NY)
RETURN
1 CALL AIVECT(NX,NY)
END